home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / cluster2.zip / SOURCE.ZIP / BOXMGR.BU next >
Text File  |  1996-07-06  |  26KB  |  584 lines
  1. $COMPILE UNIT ".\BOXMGR.PBU"
  2. $CODE SEG "SCRNLIB"
  3. $CPU      8086      ' Make compatible with XT systems
  4. $LIB      ALL OFF   ' Turn off all PowerBASIC libraries
  5. $ERROR    ALL OFF   ' Turn off all PowerBASIC error checking
  6. $OPTIMIZE SIZE      ' Optimize for smaller code
  7.  
  8. DEFINT    A-Z       ' Required for all numeric functions, forces PB to not
  9.                     ' include floating point in UNIT (makes it smaller)
  10.  
  11. '╒═══════════════════════════════════════════════════════════════════════════╕
  12. '│  This library will manage boxes, saving and restoring the                 │
  13. '│  underlying screen areas as needed.  It also has some other               │
  14. '│  handy routines, such as a scrolling text viewer, a routine               │
  15. '│  to set PowerBASIC's PRINT output to only be in the current box           │
  16. '│                                                                           │
  17. '│  This code is free for use, but is copyright Nathan C. Durland III        │
  18. '│  All rights reserved                                                      │
  19. '╞═══════════════════════════════════════════════════════════════════════════╡
  20. '│ Started Jun 10, 1996  --  Bud Durland                                     │
  21. '╞═══════════════════════════════════════════════════════════════════════════╡
  22. '│ Routines are documented with liberal comments in the routine itself       │                                                                  │
  23. '│                                                                           │
  24. '│ However, a quick overview:                                                │
  25. '│                                                                           │
  26. '│ This routine will simplify creating and using screen text boxes.          │
  27. '│ Each of the routines is pretty well commented and should be               │
  28. '│ self-explainatory.  Let me touch a couple of the highlights:              │
  29. '│                                                                           │
  30. '│  1)  always remember to call BoxInit before using any of hte other        │
  31. '│      functions listed here.  This routine sets up storage arrays          │
  32. '│      and etc.                                                             │
  33. '│                                                                           │
  34. '│  2)  To specify colors, you will be passing the routines attribute        │
  35. '│      values, which are a computed using the numeric value of the          │
  36. '│      foreground and background colors you want.  the                      │
  37. '│      MakeAttr%(Fore%,Back%) function will compute attributes for          │
  38. '│      you.  Likewise, the PB3BOXES.INC file has pre-defined                │
  39. '│      constants for most of the colors.  So, you can do something          │
  40. '│      like Box1Attr% = MakeAttr%(%BrightWhite,%Blue)                       │
  41. '│                                                                           │
  42. '│  3)  If you use -1 instead of an attribute value in PrtBox, PrtEOL,       │
  43. '│      ClearBox, or BoxTiltle, the default color attribute specified        │
  44. '│      when the box was created will be used.                               │
  45. '│                                                                           │
  46. '╘═══════════════════════════════════════════════════════════════════════════╛
  47.  
  48. DECLARE SUB GetStrLoc()     ' internal string locator in RTL
  49.  
  50. $INCLUDE ".\PB3BOXES.HDR"      ' includes defs & declares for all modules.
  51.  
  52.  
  53. SUB BoxInit(BYVAL MB%) LOCAL PUBLIC
  54. '╒═══════════════════════════════════════════════════════════════════════╕
  55. '│This sub initializes the arrays used to store window data              │
  56. '│                                                                       │
  57. '│ MB% is the the maximum numberof boxes you will be using.  5 is the    │
  58. '│ default                                                               │
  59. '│                                                                       │
  60. '╘═══════════════════════════════════════════════════════════════════════╛
  61.     CurrentBox% = 0
  62.     MaxBoxes% = MB%
  63.   IF MaxBoxes% < 1 THEN MaxBoxes% = 5
  64.  
  65.     DIM BoxParms%(1:MaxBoxes%,1:6)        ' stores Size, Color, & border type
  66.   DIM SaveText$(1:MaxBoxes%)            ' stores saved text
  67.     DIM BorderText$(0:3)                  ' Different box borders
  68.  
  69.   BorderText$(0) = CHR$( 32, 32, 32, 32, 32, 32)  ' no border
  70.   BorderText$(1) = CHR$(196,179,218,191,192,217)  ' single
  71.   BorderText$(2) = CHR$(205,186,201,187,200,188)  ' double
  72.   BorderText$(3) = CHR$(219,219,219,219,219,219)  ' Solid
  73.  
  74. END SUB
  75.  
  76. SUB MakeBox(BYVAL Row%, BYVAL Col%, BYVAL Rows%, BYVAL Cols%, _
  77.             BYVAL BoxAttr%, BYVAL Border%) LOCAL PUBLIC
  78. '╒══════════════════════════════════════════════════════════════════════════╕
  79. '│ MAKEBOX -- put a box on the screen.  underlying text is preserved        │
  80. '│            so it can be put back by the RemoveBox routine                │
  81. '│                                                                          │
  82. '│Row%  =  Top row of box                                                   │
  83. '│Col%  =  Left column                                                      │
  84. '│Rows% =  length of box                                                    │
  85. '│Cols% =  Width of box                                                     │
  86. '│BoxAttr%  =  color attribute for box                                      │
  87. '│Border%   =  border style to use 0-None 1-single 2-double 3-Solid         │
  88. '│             Add 10 to value for "3-d" border                             │
  89. '╘══════════════════════════════════════════════════════════════════════════╛
  90.   IF CurrentBox% = MaxBoxes% THEN EXIT SUB    ' no more room for making boxes.
  91.   IF Border% < 0 THEN Border% = 1
  92.  
  93.   INCR CurrentBox%,1                          ' bump box number
  94.   BoxParms%(CurrentBox%,1) = Row%             ' Save infor about Box
  95.   BoxParms%(CurrentBox%,2) = Col%
  96.   BoxParms%(CurrentBox%,3) = Rows%
  97.   BoxParms%(CurrentBox%,4) = Cols%
  98.   BoxParms%(CurrentBox%,5) = BoxAttr%
  99.   BoxParms%(CurrentBox%,6) = Border% MOD 10
  100.   lAttr% = BoxAttr%
  101.  
  102. ' Get component colors of box attribute for use in 3d effects
  103.   IF Border% > 9 THEN
  104.     CALL ReturnAttr(BoxAttr%, TheFore%, TheBack%)
  105.     IF TheFore% = TheBack% THEN         ' caller wants same fore & back colors
  106.       LowFore% = TheFore%               ' Why?  Dunno, but we'll let it happen
  107.       HiFore% = TheFore%
  108.     ELSE
  109.       LowFore% = TheFore% MOD 8           ' low intesity colors are < 8
  110.       HiFore% = LowFore% + 8              ' high intensity is => 8
  111.     END IF
  112.     lAttr% = MakeAttr%(LowFore%,TheBack%)
  113.     hAttr% = MakeAttr%(HiFore%,TheBack%)
  114.   END IF
  115.  
  116. ' Save the underlying text, then create the box!
  117.   temp$ = ""
  118.   CALL QSAVE(Row%, Col%, Rows%, Cols%, temp$)
  119.   SaveText$(CurrentBox%) = temp$
  120.   CALL QBOX(Row%, Col%, Rows%, Cols%, lAttr%, (Border% MOD 10))
  121.  
  122.   IF Border% > 10 THEN
  123.     CALL QATTR((Row% + Rows%)-1,Col%,1,Cols%,hAttr%)
  124.     CALL QATTR(Row%+1,(Col%+Cols%)-1,Rows%-1,1,hAttr%)
  125.   END IF
  126.  
  127. END SUB
  128.  
  129. SUB RemoveBox LOCAL PUBLIC
  130. '╒═════════════════════════════════════════════════════════════════════╕
  131. '│ RemoveBox -- Takes a box off the screen, and replaces it with the   │
  132. '│              saved underlying data                                  │
  133. '╘═════════════════════════════════════════════════════════════════════╛
  134.   IF CurrentBox% < 1 THEN EXIT SUB
  135.  
  136.   Row%  = BoxParms%(CurrentBox%,1)
  137.   Col%  = BoxParms%(CurrentBox%,2)
  138.   Rows% = BoxParms%(CurrentBox%,3)
  139.   Cols% = BoxParms%(CurrentBox%,4)
  140.   temp$ = SaveText$(CurrentBox%)
  141.  
  142.   CALL QREST(Row%, Col%, Rows%, Cols%, temp$)
  143.  
  144.   DECR CurrentBox%
  145.  
  146. END SUB
  147.  
  148. SUB ClearBox(BYVAL Char%, BYVAL Attr%) LOCAL PUBLIC
  149. '╒════════════════════════════════════════════════════════════════════════════╕
  150. '│ Clears the current box using the specified character and attribute         │
  151. '╞════════════════════════════════════════════════════════════════════════════╡
  152. '│Char%  --  ASCII value of character to use.  If < 0, a space is used.       │
  153. '│Attr%  --  Color attribute to use.  if < 0, the default for the box is used │